#!/usr/bin/env perl
use strict;

=head1 NAME

baliseService.pl - web service to interact with the meteosound storing system


=head1 SYNOPSIS

=head1 AUTHOR

Alexandre Masselot, C<< <alexandre dot masselot arobas framexpeditions dot com> >>


=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2006 Alexandre Masselot, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

use CGI qw(:standard);
use File::Basename;
use CGIUtils;




init();

if($query->param('action') eq 'commit'){
  my $data=$query->param('data');
  my $file=$query->param('file');
  unless ($properties{'data.dir'}){
    print "FAIL\nno {data.dir} properties";
    exit(0);
  }
  my $filename=$properties{'data.dir'}."/$file";
  unless (open(FD, ">$filename")){
    print  "FAIO\ncannot open for writing file [$filename]: $!";
    exit;
  }
  print FD<<EOT;
$data
REMOTE_ADDR=$ENV{REMOTE_ADDR}
EOT
  exit(0);
}

if(lc($query->param('out')) eq 'json'){
  print $query->header(
		       -type=>'text/plain',
		      );

  my $n;
  if(defined $query->param('showlast')){
    $n=$query->param('showlast');
  }elsif($properties{'show.last'}){
    $n=$properties{'show.last'};
  }
  my $data=readData(showlast=>$n, recentthan=>$query->param('recentthan'));

  require JSON;
  my $json=JSON->new(pretty=>1);
  print $json->objToJson($data);
  exit(0);
}



#TODO images display

print $query->header(
		     -type=>'text/html',
		    );
my %sh=(
     -title=>$properties{title}||'meteosound',
    );
$sh{-xbase}=$properties{'base.url'} if $properties{'base.url'};
$sh{-style}={src=>$properties{'css.url'}} if $properties{'css.url'};
if($properties{'icon'}){
  push @{$sh{-head}},
    Link({
	  -rel=>"SHORTCUT ICON",
	  -href=>$properties{icon},
	 });
}
print $query->start_html(%sh);

if(my $f=$properties{'header.url'}){
  local $/;
  if(open (FD, "<$f")){
    print <FD>;
  }else{
    print "cannot read <i>header.html</i> file [$f]: $!<br/>\n";
  }
}


die "no data.dir properties" unless $properties{'data.dir'};
my $path=$properties{'data.dir'}."/*";

if($query->param('cleanit')){
  die "cannot clean if no data.limit propety is set" unless $properties{'data.limit'};

  my $data=readData();
  my @sortedFiles=@{$data->{files}};
  my $limit=$properties{'data.limit'};
  my $tot;
  foreach (@sortedFiles){
    $_=$_->{filename};
    $tot+=(stat($_))[7];
    if($tot>$limit){
      unlink $_;
      print "removing $_<br/>\n";
    }
  }
}
print "<h4>Latest uploaded files</h4>\n";

my $data=readData(showlast=>($query->param('showlast')||$properties{'show.last'}-1), recentthan=>$query->param('recentthan'));

print<<EOT;
  <table class="data">
    <tbody>
EOT

my $refile=$properties{'data.filename.urlregexp'};
foreach(@{$data->{files}}){
  my $f=$_->{filename};
  eval "$refile" if $refile;
  my $urlencode=$f;
  $urlencode=~s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
  my $ext=$_->{type};
  next if $ext=~/^(txt)$/i;
  print "      <tr><td><a href='$f'>.$ext</td><td class='datainfo'>".localtime($_->{mtime})."</td><td  class='datainfo'>(".(int((stat $f)[7]/1000))."kb)</td></tr>\n";#<td><object type='application/x-shockwave-flash' data='http:/meteo.framexpeditions.com/dewplayer.swf?son=$urlencode' height=20 width=200/></tr>\n";
}
print<<EOT;
    </tbody>
  </table>

<hr width='66%'>
<p class='code'>
View properties <a href='$ENV{PATH_INFO}?showproperties=1'>here</a><br/>
View source code <a href='$ENV{PATH_INFO}?showsource=1'>here</a><br/>
</p>
EOT

print $query->end_html;



#read data from the glob;
#return a hash
# latestmtime=> time of the most recent file
# files=>\@ containing sorted files (most recent is first), each ele contains a has 
#  {
#    mtime=>
#    root=>
#    type=> (suffix)
#    filename=>
#and possibly (think of .txt files
#    contents=>
#  }


sub readData{
  my %hparams=@_;
  my $showLast=$hparams{showlast};
  my $recentThan=$hparams{recentthan};

  die "no data.dir properties" unless $properties{'data.dir'};
  my $path=$properties{'data.dir'}."/*";

  my @files=glob($path);
  my %file2mtime;
  foreach (@files){
    $file2mtime{$_}=(stat $_)[9];
  }
  my @sortedFiles=sort {$file2mtime{$b}<=>$file2mtime{$a}} @files;

  if($showLast){
    my $n=(($showLast<@sortedFiles)?$showLast:@sortedFiles)-1;
    @sortedFiles=@sortedFiles[0..$n];
  }

  if($recentThan){
    foreach(0..(scalar(@sortedFiles)-1)){
      if($file2mtime{$sortedFiles[$_]}<=$recentThan){
	#we hit an older file, remove all following
	splice @sortedFiles, $_, (scalar(@sortedFiles)-$_);
	last;
      }
    }
  }


  my @fileData;
  my %sites;
  foreach my $f (@sortedFiles){
    my %h=(
	   mtime=>$file2mtime{$f},
	   filename=>basename($f),
	  );
    my $nbytes=-s $f;
    if($nbytes<2**10){
      $h{size}=$nbytes;
    }elsif($nbytes<2**20){
      $h{size}=int($nbytes/1024)."K";
    }else{
      $h{size}=int($nbytes/(2**20))."M";
    }
    my $base=basename($f);
    if($base=~/(.*)\.(.*)/){
      $h{root}=$1;
      $h{type}=$2;
    }else{
      #should not happen to have a file withou extension but...
      $h{root}=$base;
      $h{type}='';
    }
    if($base=~/\.(\d{8})_(\d\d:\d\d:\d\d(\.\d+)?)/){
      $h{date_raw}="$1 ";
      $h{time_raw}="$2";
    }else{
      $h{date_raw}="19000101 ";
      $h{time_raw}="00:00:00";
    }
    $h{date_raw}=~/(\d{4})(\d{2})(\d{2})/;
    $h{date}=($3+0)."/".($2+0);
    $h{time_raw}=~/^(\d\d:\d\d)/;
    $h{time}=$1;
    if($h{type} eq 'txt'){
      #local $/;
      if(open (FD, "<$f")){
	$h{contents}=<FD>;
	close FD;
	my $s=(split /\t/, $h{contents}, 2)[0];
	$sites{$s}++ if $s;
      }else{
	$h{contents}="cannot open $f: $!";
      }
    }
    push @fileData, \%h;
  }

  my $latestmtime;
  if(@fileData){
    $latestmtime=$fileData[0]->{mtime}
  }else{
    $latestmtime=$recentThan||0;
  }
  my @tmp=keys %sites;
  return {
	  mtime=>$latestmtime,
	  files=>\@fileData,
	  sumary=>{sitelist=>\@tmp},
	 };
}
